home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / totsrc.zip / TOTIO2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  58KB  |  2,217 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.00                             }
  6.  
  7. Unit totIO2;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.  
  13. }
  14.  
  15. INTERFACE
  16.  
  17. uses DOS, CRT,
  18.      totSYS, totLOOK, totFAST, totSTR, totINPUT, totWIN,
  19.      totIO1, totMSG,  totLINK, totReal, totDATE;
  20.  
  21. CONST
  22.    NumberError: array[1..2] of string[60] =
  23.    (' The number you entered is out of range. ',
  24.    ' Enter a number in the following range: ');
  25.    DateError: array[1..6] of string[60] = 
  26.    (' The date you entered is invalid. ',
  27.     ' Enter a date in the format:',
  28.     ' The date you entered is too early. ',
  29.     ' The earliest acceptable date is: ',
  30.     ' The date you entered is too late. ',
  31.     ' The latest acceptable date is: ');
  32.  
  33. TYPE
  34. pSingleLineIOOBJ = ^SingleLineIOOBJ;
  35. SingleLineIOOBJ = object (VisibleIOOBJ)
  36.    vInsert: boolean;      {is field initially in insert mode}
  37.    vRules: byte;          {erasedefault, jumpiffull..... etc.}
  38.    vFirstKey: boolean;    {has the user entered a key yet}
  39.    vDispChar: char;       {character displayed when key is pressed}
  40.    vPad : Char;           {character used to pad empty part of field}
  41.    {methods ...}
  42.    constructor Init;
  43.    procedure   SetIns(InsOn:boolean);
  44.    procedure   SetRules(Rules:byte);
  45.    procedure   SetDispChar(Ch:char);
  46.    procedure   SetPadChar(Pad:char);
  47.    procedure   SetFieldAttr(Status:tStatus; var Attr:byte; var Str:string);
  48.    procedure   InsertAction(InsOn:boolean);                     VIRTUAL;
  49.    destructor  Done;                                            VIRTUAL;
  50. end;  {SingleLineIOOBJ}
  51.  
  52. pCharIOOBJ = ^CharIOOBJ;
  53. CharIOOBJ = object (SingleLineIOOBJ)
  54.    vFieldLen: byte;
  55.    vMaxlen : byte;
  56.    vInputStr: StrScreen;
  57.    vCursor: tCursPos;     {cursleft cursright cursprevious}
  58.    vCursorStr: byte;      {position of cursor in string}
  59.    vJust: tJust;          {left center right}
  60.    {methods ...}
  61.    constructor Init(X,Y,FieldLen: byte);
  62.    procedure   SetJust(Just:tJust);
  63.    procedure   SetCursor(Curs: tCursPos);
  64.    procedure   ClearMessage;
  65.    function    ProcessKey(InKey:word;X,Y:byte):tAction;         VIRTUAL;
  66.    function    CharOK(var Ch:char): boolean;                    VIRTUAL;
  67.    procedure   Erase;                                           VIRTUAL;
  68.    procedure   CursorEnd;                                       VIRTUAL;
  69.    procedure   CursorHome;                                      VIRTUAL;
  70.    procedure   CursorLeft;                                      VIRTUAL;
  71.    procedure   CursorRight;                                     VIRTUAL;
  72.    procedure   DeleteChar;                                      VIRTUAL;
  73.    procedure   Backspace;                                       VIRTUAL;
  74.    procedure   MoveCursor;                                      VIRTUAL;
  75.    function    ProcessEnter:tAction;                            VIRTUAL;
  76.    procedure   ReDisplay(Status:tStatus);                       VIRTUAL;
  77.    procedure   PosCursor;                                       VIRTUAL;
  78.    procedure   Display(Status:tStatus);                         VIRTUAL;
  79.    procedure   ProcessChar(Ch:char);                            VIRTUAL;
  80.    procedure   Activate;                                        VIRTUAL;
  81.    function    Select(K:word; X,Y:byte): tAction;               VIRTUAL;
  82.    function    Suspend:boolean;                                 VIRTUAL;
  83.    destructor  Done;                                            VIRTUAL;
  84. end; {object CharIOOBJ}
  85.  
  86. pStringIOOBJ = ^StringIOOBJ;
  87. StringIOOBJ = object (CharIOOBJ)
  88.    vCase: tCase;            {lower upper proper}
  89.    vForceCase: boolean;     {adjust case of characters during input}
  90.    {methods ...}
  91.    constructor Init(X,Y,FieldLen: byte);
  92.    procedure   SetCase(Cas:tCase);
  93.    procedure   SetForceCase(On:boolean);
  94.    procedure   SetValue(Str:string);
  95.    function    GetValue: string;
  96.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  97.    destructor  Done;                                        VIRTUAL;
  98. end; {StringIOOBJ}
  99.  
  100. pPictureIOOBJ = ^PictureIOOBJ;
  101. PictureIOOBJ = object (StringIOOBJ)
  102.    vPicture: string[80];
  103.    vCursorScr: byte;          {position of cursor including format characters}
  104.    vAllowChar: string[40];    {allowable characters}
  105.    vDisAllowChar: string[40]; {disallowed characters}
  106.    {methods ...}
  107.    constructor Init(X,Y: byte;Pic:string);
  108.    function    InputChars: byte;
  109.    function    CursorOffset(InputPos:byte):byte;
  110.    procedure   SetAllowChar(Str:string);
  111.    procedure   SetDisallowChar(Str:string);
  112.    function    GetValue: string;
  113.    function    GetPicValue: string;
  114.    function    CharOK(var Ch:char):boolean;                 VIRTUAL;
  115.    procedure   Erase;                                       VIRTUAL;
  116.    procedure   CursorEnd;                                   VIRTUAL;
  117.    procedure   CursorHome;                                  VIRTUAL;
  118.    procedure   CursorLeft;                                  VIRTUAL;
  119.    procedure   CursorRight;                                 VIRTUAL;
  120.    procedure   DeleteChar;                                  VIRTUAL;
  121.    procedure   Backspace;                                   VIRTUAL;
  122.    procedure   PosCursor;                                   VIRTUAL;
  123.    procedure   MoveCursor;                                  VIRTUAL;
  124.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  125.    destructor  Done;                                        VIRTUAL;
  126. end; {PictureIOOBJ}
  127.  
  128. pLateralIOOBJ = ^LateralIOOBJ;
  129. LateralIOOBJ = object (StringIOOBJ)
  130.    vStartChar: byte;         {the number of the first visible character}
  131.    {methods ...}
  132.    constructor Init(X,Y,FieldLen,MaxLen: byte);
  133.    function    CursorOffset(InputPos:byte):byte;
  134.    function    GetValue: string;
  135.    procedure   Erase;                                       VIRTUAL;
  136.    procedure   CursorEnd;                                   VIRTUAL;
  137.    procedure   CursorHome;                                  VIRTUAL;
  138.    procedure   CursorLeft;                                  VIRTUAL;
  139.    procedure   CursorRight;                                 VIRTUAL;
  140.    procedure   DeleteChar;                                  VIRTUAL;
  141.    procedure   Backspace;                                   VIRTUAL;
  142.    procedure   PosCursor;                                   VIRTUAL;
  143.    procedure   MoveCursor;                                  VIRTUAL;
  144.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  145.    destructor  Done;                                        VIRTUAL;
  146. end; {LateralIOOBJ}
  147.  
  148. pListIOOBJ = ^ListIOOBJ;
  149. ListIOOBJ = object (MultiLineIOOBJ)
  150.    vTopPick: integer;         {number of first pick in window}
  151.    vTotPicks: integer;        {total number of picks}
  152.    vListAssigned: boolean;    {is data assigned to list}
  153.    vScrollBarOn: boolean;     {is the vertical scrollbar required}
  154.    vBoxBorder: boolean;       {is the list enclosed in a box}
  155.    vActivePick: integer;      {the offset of the active pick from the top}
  156.    vActiveField: boolean;     {is field highlighted}
  157.    {methods ...}
  158.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  159.    procedure   WriteItem(Item:integer; Selected:boolean);
  160.    procedure   DisplayAllPicks;
  161.    procedure   RefreshScrollbar;
  162.    function    HitItem(Y:byte):byte;
  163.    procedure   ScrollJump(Y:byte);
  164.    procedure   ScrollUp;
  165.    procedure   ScrollDown;
  166.    procedure   ScrollPgUp;
  167.    procedure   ScrollPgDn;
  168.    procedure   ScrollEnd;
  169.    procedure   ScrollHome;
  170.    procedure   AdjustMouseKey(var InKey: word;X,Y:byte);
  171.    function    TargetPick(X,Y:byte): longint;
  172.    procedure   MouseChoose(X,Y:byte);
  173.    function    GetValue: integer;
  174.    procedure   ShowItemDetails(HiPick: integer);            VIRTUAL;
  175.    function    SelectPick(InKey:word;X,Y:byte): tAction;    VIRTUAL;
  176.    function    Select(K:word; X,Y:byte):tAction;            VIRTUAL;
  177.    function    ProcessKey(InKey:word;X,Y:byte):tAction;     VIRTUAL;
  178.    procedure   Display(Status:tStatus);                     VIRTUAL;
  179.    function    Suspend:boolean;                             VIRTUAL;
  180.    function    GetString(Pick:integer): string;             VIRTUAL;
  181.    destructor  Done;                                        VIRTUAL;
  182. end; {ListIOOBJ}
  183.  
  184. pArrayIOOBJ = ^ArrayIOOBJ;
  185. ArrayIOOBJ = object (ListIOOBJ)
  186.    vArrayPtr: pointer;
  187.    vStrLength: byte;
  188.    {methods ...}
  189.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  190.    procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
  191.    function    GetString(Pick:integer): string;             VIRTUAL;
  192.    destructor  Done;                                        VIRTUAL;
  193. end; {ArrayIOOBJ}
  194.  
  195. pLinkIOOBJ = ^LinkIOOBJ;
  196. LinkIOOBJ = object (ListIOOBJ)
  197.    vLinkList: ^DLLOBJ;
  198.    {methods ...}
  199.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  200.    procedure   AssignList(var LinkList: DLLOBJ);
  201.    function    GetString(Pick:integer): string;             VIRTUAL;
  202.    destructor  Done;                                        VIRTUAL;
  203. end; {LinkIOOBJ}
  204.  
  205. pIntIOOBJ = ^IntIOOBJ;
  206. IntIOOBJ = object (CharIOOBJ)
  207.    vMin: longint;
  208.    vMax: longint;
  209.    vFmtPtr: pFmtNumberOBJ;
  210.    {methods...}
  211.    constructor Init(X,Y,Len: byte);
  212.    procedure   InitFormat;
  213.    function    FormatPtr: pFmtNumberOBJ;
  214.    function    GetValue: longint;
  215.    procedure   SetValue(Val:longint);
  216.    procedure   SetMinMax(Min,Max: longint);
  217.    function    CharOK(var Ch:char):boolean;                 VIRTUAL;
  218.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  219.    function    Suspend:boolean;                             VIRTUAL;
  220.    destructor  Done;                                        VIRTUAL;
  221. end; {object IntIOOBJ}
  222.  
  223. pRealIOOBJ = ^RealIOOBJ;
  224. RealIOOBJ = object (CharIOOBJ)
  225.    vMin: Extended;
  226.    vMax: Extended;
  227.    vENotation: boolean;
  228.    vFmtPtr: pFmtNumberOBJ;
  229.    {methods...}
  230.    constructor Init(X,Y,Len:byte);
  231.    procedure   InitFormat;
  232.    function    FormatPtr: pFmtNumberOBJ;
  233.    function    GetValue: extended;
  234.    procedure   SetMinMax(Min,Max:extended);
  235.    procedure   SetValue(Val:extended);
  236.    procedure   SetENotation(On:Boolean);
  237.    function    CharOK(var Ch:char):boolean;                 VIRTUAL;
  238.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  239.    function    Suspend:boolean;                             VIRTUAL;
  240.    destructor  Done;                                        VIRTUAL;
  241. end; {RealIOOBJ}
  242.  
  243. pFixedRealIOOBJ = ^FixedRealIOOBJ;
  244. FixedRealIOOBJ = object (SingleLineIOOBJ)
  245.    vMin: Extended;
  246.    vMax: Extended;
  247.    vDP: byte;
  248.    vWholeP: byte;
  249.    vMaxlen : byte;
  250.    vCursorPos: byte;
  251.    vWholeStr: StrVisible;
  252.    vDPStr: string[20]; {max significance of Turbo reals}
  253.    vFmtPtr: pFmtNumberOBJ;
  254.    {methods...}
  255.    constructor Init(X,Y,Whole,DP:byte);
  256.    procedure   InitFormat;
  257.    function    FormatPtr: pFmtNumberOBJ;
  258.    procedure   Erase;
  259.    procedure   CursorEnd;
  260.    procedure   CursorHome;
  261.    procedure   CursorLeft;
  262.    procedure   CursorRight;
  263.    procedure   DeleteChar;
  264.    procedure   Backspace;
  265.    function    GetValue: extended;
  266.    procedure   SetMinMax(Min,Max:extended);
  267.    procedure   SetValue(Val:extended);
  268.    procedure   ProcessChar(Ch:char);
  269.    function    ProcessEnter:tAction;
  270.    procedure   Condense;
  271.    procedure   PeriodHit;
  272.    procedure   PlusHit;
  273.    procedure   MinusHit;
  274.    procedure   MoveCursor;
  275.    procedure   Display(Status:tStatus);                         VIRTUAL;
  276.    function    ProcessKey(InKey:word;X,Y:byte):tAction;         VIRTUAL;
  277.    procedure   Activate;                                        VIRTUAL;
  278.    function    Select(K:word; X,Y:byte): tAction;               VIRTUAL;
  279.    function    Suspend:boolean;                                 VIRTUAL;
  280.    destructor  Done;                                            VIRTUAL;
  281. end; {FixedRealIOOBJ}
  282.  
  283. pDateIOOBJ = ^DateIOOBJ;
  284. DateIOOBJ = object (PictureIOOBJ)
  285.    vDateFmt: tdate;
  286.    vMin: longint;
  287.    vMax: longint;
  288.    {methods...}
  289.    constructor Init(X,Y:byte;DateFmt:tDate);
  290.    procedure   SetMinMax(Min,Max:longint);
  291.    procedure   SetValue(Date:longint);
  292.    function    GetValue: longint;
  293.    function    Suspend:boolean;                                 VIRTUAL;
  294.    destructor  Done;                                            VIRTUAL;
  295. end; {DateIOOBJ}
  296.  
  297. pHexIOOBJ = ^HexIOOBJ;
  298. HexIOOBJ = object (PictureIOOBJ)
  299.    vMin: longint;
  300.    vMax: longint;
  301.    {methods...}
  302.    constructor Init(X,Y,Len:byte);
  303.    procedure   SetMinMax(Min,Max:longint);
  304.    procedure   SetValue(Val:longint);
  305.    function    GetValue: longint;
  306.    function    Suspend:boolean;                                 VIRTUAL;
  307.    destructor  Done;                                            VIRTUAL;
  308. end; {HexIOOBJ}
  309.  
  310. procedure IO2Init;
  311.  
  312. var
  313.   FmtNumberTOT: FmtNumberOBJ;
  314.   
  315. IMPLEMENTATION
  316.  
  317. procedure ValidationMessage(Line1,Line2,Line3,Line4:string);
  318. {}
  319. var
  320.    Msg: MessageOBJ;
  321. begin
  322.    with Msg do
  323.    begin
  324.       Init(2,' Invalid Input! ');
  325.       AddLine('');
  326.       AddLine(' '+Line1);
  327.       AddLine(' '+Line2);
  328.       AddLine(' '+Line3);
  329.       AddLine(' '+Line4);
  330.       AddLine('');
  331.       Show;
  332.       Done;
  333.    end; {with}
  334. end; {ValidationMessage}
  335. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  336. {                                                      }
  337. {     S i n g l e L i n e I O O B J   M E T H O D S    }
  338. {                                                      }
  339. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  340. constructor SingleLineIOOBJ.Init;
  341. {}
  342. begin
  343.    VisibleIOOBJ.Init;
  344.    vDispChar := ' ';
  345.    vInsert := IOTOT^.InputIns;
  346.    vRules := IOTOT^.InputRules;
  347.    vPad := IOTOT^.InputPad;
  348. end; {SingleLineIOOBJ.Init}
  349.  
  350. procedure SingleLineIOOBJ.InsertAction(InsOn:boolean);
  351. {}
  352. begin
  353.    if InsOn then
  354.       Screen.CursHalf
  355.    else
  356.       Screen.CursOn;
  357. end; {SingleLineIOOBJ.ChangeMode}
  358.  
  359. procedure SingleLineIOOBJ.SetIns(InsOn:boolean);
  360. {}
  361. begin
  362.    vInsert := InsOn;
  363. end; {SingleLineIOOBJ.SetIns}
  364.  
  365. procedure SingleLineIOOBJ.SetRules(Rules:byte);
  366. {}
  367. begin
  368.    vRules := Rules;
  369. end; {SetRules}
  370.  
  371. procedure SingleLineIOOBJ.SetPadChar(Pad:char);
  372. {}
  373. begin
  374.    vPad := Pad;
  375. end; {SingleLineIOOBJ.SetPadChar}
  376.  
  377. procedure SingleLineIOOBJ.SetFieldAttr(Status:tStatus; var Attr:byte; var Str:string);
  378. {}
  379. begin
  380.    case Status of
  381.    HiStatus:    Attr := IOTOT^.FieldCol(2);
  382.    Norm:  Attr := IOTOT^.FieldCol(1);
  383.    Off:   Attr := IOTOT^.FieldCol(4);
  384.    end; {case}
  385.    if (vDispChar <> ' ') then
  386.       Str := Replicate(length(Str),vDispChar);
  387. end; {SingleLineIOOBJ.SetFieldAttr}
  388.  
  389. procedure SingleLineIOOBJ.SetDispChar(Ch:char);
  390. {}
  391. begin
  392.    vDispChar := Ch;
  393. end; {SingleLineIOOBJ.SetDispChar}
  394.  
  395. destructor SingleLineIOOBJ.Done;
  396. {}
  397. begin
  398.    VisibleIOOBJ.Done;
  399. end; {SingleLineIOOBJ.Done}
  400. {||||||||||||||||||||||||||||||||||||||||||}
  401. {                                          }
  402. {     C h a r I O O B J   M E T H O D S    }
  403. {                                          }
  404. {||||||||||||||||||||||||||||||||||||||||||}
  405. constructor CharIOOBJ.Init(X,Y,FieldLen: byte);
  406. {}
  407. var
  408.   W : byte;
  409. begin
  410.    SingleLineIOOBJ.Init;
  411.    vInputStr := '';
  412.    vCursor := IOTOT^.InputCursorLoc;
  413.    vCursorStr := 1;
  414.    vJust := IOTOT^.InputJust;
  415. {$IFDEF CHECK}
  416.    W := Monitor^.Width;
  417.    if X > W then
  418.       vBoundary.X1 := 1
  419.    else
  420.       vBoundary.X1 := X;
  421.    vBoundary.Y1 := Y;
  422.    vBoundary.Y2 := vBoundary.Y1;
  423.    if pred(vBoundary.X1 + FieldLen) > W then
  424.       vFieldLen := succ(W - vBoundary.X1)
  425.    else
  426.       vFieldLen := FieldLen;
  427.    vBoundary.X2 := pred(vBoundary.X1 + FieldLen);
  428. {$ELSE}
  429.    vBoundary.X1 := X;
  430.    vBoundary.X2 := pred(vBoundary.X1 + FieldLen);
  431.    vBoundary.Y1 := Y;
  432.    vBoundary.Y2 := vBoundary.Y1;
  433.    vFieldlen := FieldLen;
  434. {$ENDIF}
  435.    vMaxlen := vFieldLen;
  436. end; {cons CharIOOBJ.Init}
  437.  
  438. procedure CharIOOBJ.SetCursor(Curs:tCursPos);
  439. {}
  440. begin
  441.    vCursor := Curs;
  442. end; {CharIOOBJ.SetCurs}
  443.  
  444. procedure CharIOOBJ.SetJust(Just:tJust);
  445. {}
  446. begin
  447.    vJust := Just;
  448. end; {CharIOOBJ.SetJust}
  449.  
  450. procedure CharIOOBJ.CursorHome;
  451. {}
  452. begin
  453.    vCursorStr := 1;
  454.    Display(HiStatus);
  455. end; {CharIOOBJ.CursorHome}
  456.  
  457. procedure CharIOOBJ.CursorEnd;
  458. {}
  459. begin
  460.    if (vCursorStr <= length(vInputStr)) then
  461.       vCursorStr := succ(length(vInputStr));
  462. end; {CharIOOBJ.CursorEnd}
  463.  
  464. procedure CharIOOBJ.CursorLeft;
  465. {}
  466. begin
  467.    if vCursorStr > 1 then
  468.       dec(vCursorStr);
  469. end; {CharIOOBJ.CursorLeft}
  470.  
  471. procedure CharIOOBJ.CursorRight;
  472. {}
  473. begin
  474.    if (vCursorStr <= length(vInputStr)) then
  475.          inc(vCursorStr);
  476. end; {CharIOOBJ.CursorRight}
  477.  
  478. procedure CharIOOBJ.Erase;
  479. {}
  480. begin
  481.    vInputStr := '';
  482.    vCursorStr := 1;
  483.    Display(HiStatus);
  484. end; {CharIOOBJ.Erase}
  485.  
  486. procedure CharIOOBJ.DeleteChar;
  487. {}
  488. begin
  489.   delete(vInputStr,vCursorStr,1);
  490.   Display(HiStatus);
  491. end; {CharIOOBJ.DeleteChar}
  492.  
  493. procedure CharIOOBJ.BackSpace;
  494. {}
  495. begin
  496.    if vCursorStr > 1 then
  497.    begin
  498.       CursorLeft;
  499.       DeleteChar;
  500.       Display(HiStatus)
  501.    end;
  502. end; {CharIOOBJ.BackSpace}
  503.  
  504. function CharIOOBJ.ProcessEnter:tAction;
  505. {}
  506. begin
  507.    ProcessEnter := Enter;
  508. end; {CharIOOBJ.ProcessEnter}
  509.  
  510. procedure CharIOOBJ.MoveCursor;
  511. {}
  512. begin
  513.    Screen.GotoXY(pred(vBoundary.X1)+vCursorStr,vBoundary.Y1);
  514. end; {CharIOOBJ.MoveCursor}
  515.  
  516. procedure CharIOOBJ.PosCursor;
  517. {}
  518. begin
  519.    case vCursor of
  520.       CursLeft:  vCursorStr := 1;
  521.       CursRight: vCursorStr := succ(length(vInputStr));
  522.       CursPrev:  {do nothing};
  523.    end; {case}
  524. end; {CharIOOBJ.PosCursor}
  525.  
  526. procedure CharIOOBJ.ReDisplay(Status:tStatus);
  527. {abstract}
  528. begin end;
  529.  
  530. procedure CharIOOBJ.Display(Status:tStatus);
  531. {}
  532. begin
  533.    PosCursor;
  534.    ReDisplay(Status);
  535. end; {CharIOOBJ.Display}
  536.  
  537. function CharIOOBJ.CharOK(var Ch:char): boolean;
  538. {}
  539. begin
  540.    CharOK := true;
  541. end; {CharIOOBJ.CharOK}
  542.  
  543. procedure CharIOOBJ.ProcessChar(Ch:char);
  544. {}
  545.  
  546.    procedure EraseOld;
  547.    {}
  548.    begin
  549.       if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then
  550.          Erase;
  551.    end; {EraseOld}
  552.  
  553. begin
  554.    if ( ( (vInsert and (length(vInputStr) >= vMaxlen))
  555.           or
  556.           (vCursorStr > vMaxLen)
  557.         )
  558.         and
  559.         ((vFirstKey and ((vRules and EraseDefault) = EraseDefault))=false)
  560.       ) then
  561.       Ding
  562.    else
  563.    begin
  564.       if CharOK(Ch) then
  565.          EraseOld
  566.       else
  567.       begin
  568.          Ding;
  569.          exit
  570.       end;
  571.       if not vInsert then
  572.          Delete(vInputStr,vCursorStr,1);
  573.       insert(Ch,vInputStr,vCursorStr);
  574.       CursorRight;
  575.       ReDisplay(HiStatus);
  576.    end;
  577. end; {CharIOOBJ.ProcessChar}
  578.  
  579. function CharIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  580. {}
  581. begin
  582.    Case InKey of
  583.       8: BackSpace;
  584.       288: Erase;  {Alt-D}
  585.       339: DeleteChar;
  586.       327: CursorHome;
  587.       335: CursorEnd;
  588.       331: CursorLeft;
  589.       333: CursorRight;
  590.       338: begin
  591.               vInsert := not vInsert;
  592.               InsertAction(vInsert);
  593.            end;
  594.       32..255: ProcessChar(chr(InKey));    {characters}
  595.    end; {case}
  596.    case InKey of
  597.       523,13: ProcessKey := ProcessEnter;
  598.       27: ProcessKey := Escaped;
  599.       else 
  600.       begin
  601.          if  ((vRules and JumpIfFull) = JumpIfFull)
  602.          and (length(vInputStr) >= vMaxlen)
  603.          and ( (Inkey >= 32) and (InKey <= 255)) 
  604.          and (vCursorStr > vMaxLen) then
  605.             ProcessKey := NextField
  606.          else
  607.             ProcessKey := None;
  608.       end;
  609.    end;
  610.    vFirstKey := false;
  611.    MoveCursor;
  612. end; {CharIOOBJ.ProcessKey}
  613.  
  614. procedure CharIOOBJ.Activate;
  615. {}
  616. var
  617.    Action: tAction;
  618. begin
  619.    repeat
  620.       Action := Select(0,0,0);
  621.       Display(HiStatus);
  622.       WriteLabel(HiStatus);
  623.       with Key do 
  624.       repeat
  625.          GetInput;
  626.          if LastKey = 27 then
  627.             Action := Escaped
  628.          else
  629.             Action := ProcessKey(LastKey,LastX,LastY);
  630.       until Action in [Finished,Escaped,Enter];
  631.    until (Action = Escaped) or Suspend;
  632. end; {CharIOOBJ.Activate}
  633.  
  634. function CharIOOBJ.Select(K:word; X,Y:byte): tAction;
  635. {}
  636. begin
  637.    Display(HiStatus);
  638.    WriteLabel(HiStatus);
  639.    WriteMessage;
  640.    vFirstKey := true;
  641.    InsertAction(vInsert);
  642.    PosCursor;
  643.    MoveCursor;
  644.    Select := None;
  645. end; {CharIOOBJ.Select}
  646.  
  647. procedure CharIOOBJ.ClearMessage;
  648. {}
  649. var Col,L: byte;
  650. begin
  651.    if vMsgPtr <> Nil then   {clear the message}
  652.    begin
  653.       move(vMsgPtr^,L,1);
  654.       if L > 0 then
  655.       begin
  656.          Col := IOTOT^.MessageCol;
  657.          if Col = 0 then
  658.             Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
  659.          else
  660.             Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
  661.       end;
  662.    end;
  663. end; {CharIOOBJ.ClearMessage}
  664.  
  665. function CharIOOBJ.Suspend:boolean;
  666. {}
  667. begin
  668.    ReDisplay(Norm);
  669.    WriteLabel(Norm);
  670.    ClearMessage;
  671.    Suspend := true;
  672. end; {CharIOOBJ.Suspend}
  673.  
  674. destructor CharIOOBJ.Done;
  675. {}
  676. begin
  677.    SingleLineIOOBJ.Done;
  678. end; {CharIOOBJ.Done}
  679.  
  680. {||||||||||||||||||||||||||||||||||||||||||||||}
  681. {                                              }
  682. {     S t r F i e l d O B J   M E T H O D S    }
  683. {                                              }
  684. {||||||||||||||||||||||||||||||||||||||||||||||}
  685. constructor StringIOOBJ.Init(X,Y,FieldLen: byte);
  686. {}
  687. begin
  688.    CharIOOBJ.Init(X,Y,FieldLen);
  689.    vCase := IOTOT^.InputCase;
  690.    vForceCase := IOTOT^.InputForceCase;
  691. end; {StringIOOBJ.Init}
  692.  
  693. procedure StringIOOBJ.SetValue(Str:string);
  694. {}
  695. begin
  696.    vInputStr := Str;
  697.    if vCursorStr > succ(length(Str)) then
  698.       vCursorStr :=  succ(length(Str));
  699.    PosCursor;
  700. end; {StringIOOBJ.SetValue}
  701.  
  702. procedure StringIOOBJ.SetCase(Cas:tCase);
  703. {}
  704. begin
  705.    vCase := Cas;
  706. end; {StringIOOBJ.SetCase}
  707.  
  708. procedure StringIOOBJ.SetForceCase(On:boolean);
  709. {}
  710. begin
  711.    vForceCase := On;
  712. end; {StringIOOBJ.SetForceCase}
  713.  
  714. function StringIOOBJ.GetValue: string;
  715. {}
  716. begin
  717.    GetValue := vInputStr;
  718. end; {StringIOOBJ.GetValue}
  719.  
  720. procedure StringIOOBJ.ReDisplay(Status:tStatus);
  721. {}
  722. var
  723.   A: byte;
  724.   AdjStr: String;
  725. begin
  726.    if (Status <> HiStatus)
  727.    or ((Status = HiStatus) and vForceCase) then
  728.       vInputStr := AdjCase(vCase,vInputStr);
  729.    if (vDispChar = ' ') then
  730.       AdjStr := vInputStr
  731.    else
  732.       AdjStr := Replicate(length(vInputStr),vDispChar);
  733.    if Status = HiStatus then
  734.    begin
  735.      SetFieldAttr(Status,A,AdjStr);
  736.      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(AdjStr,vFieldlen,vPad));
  737.    end
  738.    else
  739.    begin
  740.       SetFieldAttr(Status,A,AdjStr);  {was norm}
  741.       AdjStr := Pad(vJust,AdjStr,vFieldLen,vPad);
  742.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,AdjStr);
  743.    end;
  744. end; {StringIOOBJ.ReDisplay}
  745.  
  746. destructor StringIOOBJ.Done;
  747. {}
  748. begin
  749.    CharIOOBJ.Done;
  750. end; {StringIOOBJ.Done}
  751. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  752. {                                                    }
  753. {     P i c S t r F i e l d O B J   M E T H O D S    }
  754. {                                                    }
  755. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  756. constructor PictureIOOBJ.Init(X,Y: byte;Pic:string);
  757. {}
  758. begin
  759.    StringIOOBJ.Init(X,Y,length(Pic));
  760.    vPicture := Pic;
  761.    vFieldLen := InputChars;
  762.    vMaxlen := vFieldlen;
  763.    vAllowChar := '';
  764.    vDisAllowChar := '';
  765.    SetIns(IOTOT^.InputIns);
  766. end; {PictureIOOBJ.Init}
  767.  
  768. function PictureIOOBJ.InputChars: byte;
  769. {}
  770. var
  771.   Counter : byte;
  772.   I : integer;
  773. begin
  774.   Counter := 0;
  775.   for I := 1 to length(vPicture) do
  776.       if vPicture[I] in FmtChars then
  777.          Inc(Counter);
  778.   InputChars := counter;
  779. end; {PictureIOOBJ.InputChars}
  780.  
  781. procedure PictureIOOBJ.SetAllowChar(Str:string);
  782. {}
  783. begin
  784.    vAllowChar := Str;
  785. end; {PictureIOOBJ.SetAllowChar}
  786.  
  787. procedure PictureIOOBJ.SetDisAllowChar(Str:string);
  788. {}
  789. begin
  790.    vDisAllowChar := Str;
  791. end; {PictureIOOBJ.SetDisAllowChar}
  792.  
  793. procedure PictureIOOBJ.ReDisplay(Status:tStatus);
  794. {}
  795. var
  796.   A,B,Len: byte;
  797.   Counter,I: integer;
  798.   AdjStr,
  799.   TempStr : string;
  800. begin
  801.    AdjStr := vInputStr;
  802.    SetFieldAttr(Status,A,AdjStr);
  803.    if Status <> HiStatus Then
  804.    begin
  805.       vInputStr := AdjCase(vCase,vInputStr);
  806.       TempStr := PicFormat(AdjStr,vPicture,vPad);
  807.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,TempStr);
  808.    end
  809.    else
  810.    begin
  811.      B := IOTot^.FieldCol(3);
  812.      Counter := 0;
  813.      Len := length(vInputStr);
  814.      for I := 1 to length(vPicture) do
  815.      begin
  816.         if (vPicture[I] in FmtChars) then
  817.         begin
  818.            inc(Counter);
  819.            if Counter <= Len then
  820.               Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,A,vInputStr[Counter])
  821.            else
  822.               Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,A,vPad);
  823.         end
  824.         else
  825.            Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,B,vPicture[I]);
  826.      end;
  827.    end;
  828. end; {PictureIOOBJ.ReDisplay}
  829.  
  830. function PictureIOOBJ.CursorOffset(InputPos:byte):byte;
  831. {}
  832. var
  833.    Counter: byte;
  834.    CharPos: byte;
  835.    L : byte;
  836. begin
  837.    Counter := 0;
  838.    CharPos := 0;
  839.    L := length(vPicture);
  840.    repeat
  841.       inc(Counter);
  842.       if vPicture[Counter] in FmtChars then
  843.          inc(CharPos);
  844.    until (CharPos = InputPos) or (Counter > L);
  845.    CursorOffset := Counter + pred(vBoundary.X1);
  846. end; {PictureIOOBJ.CursorOffset}
  847.  
  848. procedure PictureIOOBJ.PosCursor;
  849. {}
  850. begin
  851.    StringIOOBJ.PosCursor;
  852.    vCursorScr := CursorOffset(vCursorStr);
  853. end; {PictureIOOBJ.PosCursor}
  854.  
  855. procedure PictureIOOBJ.Erase;
  856. {}
  857. begin
  858.    vInputStr := '';
  859.    vCursorStr := 1;
  860.    PosCursor;
  861.    Display(HiStatus);
  862. end; {PictureIOOBJ.Erase}
  863.  
  864. procedure PictureIOOBJ.CursorHome;
  865. {}
  866. begin
  867.    vCursorStr := 1;
  868.    vCursorScr := CursorOffset(vCursorStr);
  869. end; {PictureIOOBJ.CursorHome}
  870.  
  871. procedure PictureIOOBJ.CursorEnd;
  872. {}
  873. begin
  874.    if (vCursorStr <= length(vInputStr)) then
  875.    begin
  876.       vCursorStr := succ(length(vInputStr));
  877.       vCursorScr := CursorOffset(vCursorStr);
  878.    end;
  879. end; {PictureIOOBJ.CursorEnd}
  880.  
  881. procedure PictureIOOBJ.CursorLeft;
  882. {}
  883. begin
  884.    if vCursorStr > 1 then
  885.    begin
  886.       dec(vCursorStr);
  887.       Repeat
  888.          dec(vCursorScr);
  889.       Until vPicture[succ(vCursorScr - vBoundary.X1)] in FmtChars;
  890.    end;
  891. end; {PictureIOOBJ.CursorLeft}
  892.  
  893. procedure PictureIOOBJ.CursorRight;
  894. {}
  895. begin
  896.    if (vCursorStr <= length(vInputStr)) then
  897.    begin
  898.       Inc(vCursorStr);
  899.       Repeat
  900.          Inc(vCursorScr);
  901.       Until (succ(vCursorScr-vBoundary.X1) > length(vPicture))
  902.          or (vPicture[succ(vCursorScr - vBoundary.X1)] in FmtChars);
  903.    end;
  904. end; {PictureIOOBJ.CursorRight}
  905.  
  906. procedure PictureIOOBJ.DeleteChar;
  907. {}
  908. begin
  909.   delete(vInputStr,vCursorStr,1);
  910.   ReDisplay(HiStatus);
  911. end; {PictureIOOBJ.DeleteChar}
  912.  
  913. procedure PictureIOOBJ.BackSpace;
  914. {}
  915. begin
  916.    if vCursorStr > 1 then
  917.    begin
  918.       CursorLeft;
  919.       DeleteChar;
  920.       ReDisplay(HiStatus)
  921.    end;
  922. end; {PictureIOOBJ.BackSpace}
  923.  
  924. function PictureIOOBJ.CharOK(var Ch:char):boolean;
  925. {}
  926. var
  927.    PicChar : char;
  928. begin
  929.    if ((vAllowChar <> '') and (pos(Ch,vAllowChar) = 0))
  930.    or ((vDisAllowChar <> '') and (pos(Ch,vDisAllowChar) > 0)) then
  931.       CharOK := false
  932.    else
  933.    begin
  934.       PicChar := vPicture[succ(vCursorScr - vBoundary.X1)];
  935.       if PicChar = '!' then
  936.          Ch := upcase(Ch);
  937.       CharOK :=  ((Ch in ['0'..'9',FmtNumberTOT.GetDecimal,'-']) and (PicChar = '#'))
  938.               or ((AlphabetTOT^.IsLetter(ord(Ch)) or AlphabetTOT^.IsPunctuation(ord(Ch))) and (PicChar = '@'))
  939.               or (PicChar in ['*','!']);
  940.       end;
  941. end; {PictureIOOBJ.CharOK}
  942.  
  943. procedure PictureIOOBJ.MoveCursor;
  944. {}
  945. begin
  946.    Screen.GotoXY(vCursorScr,vBoundary.Y1);
  947. end; {PictureIOOBJ.MoveCursor}
  948.  
  949. function PictureIOOBJ.GetValue:string;
  950. {}
  951. begin
  952.    GetValue := vInputStr;
  953. end; {PictureIOOBJ.GetValue}
  954.  
  955. function PictureIOOBJ.GetPicValue:string;
  956. {}
  957. begin
  958.    GetPicValue := PicFormat(vInputStr,vPicture,' ');
  959. end; {PictureIOOBJ.GetPicValue}
  960.  
  961. destructor PictureIOOBJ.Done;
  962. {}
  963. begin
  964.    CharIOOBJ.Done;
  965. end; {PictureIOOBJ.Done}
  966.  
  967. {||||||||||||||||||||||||||||||||||||||||||||||||}
  968. {                                                }
  969. {     L a t e r a l I O O B J   M E T H O D S    }
  970. {                                                }
  971. {||||||||||||||||||||||||||||||||||||||||||||||||}
  972.  
  973. constructor LateralIOOBJ.Init(X,Y,FieldLen,MaxLen: byte);
  974. {}
  975. begin
  976.    StringIOOBJ.Init(X,Y,FieldLen);
  977.    vStartChar := 1;
  978. {$IFDEF CHECK}
  979.    if Maxlen < vFieldlen then
  980.       vMaxlen := vFieldLen
  981.    else
  982.       vMaxLen := MaxLen;
  983. {$ELSE}
  984.    vMaxLen := MaxLen;
  985. {$ENDIF}
  986. end; {LateralIOOBJ.Init}
  987.  
  988. procedure LateralIOOBJ.ReDisplay(Status:tStatus);
  989. {}
  990. var
  991.   A: byte;
  992.   AdjStr,
  993.   TempStr : string;
  994. begin
  995.    if (Status <> HiStatus)
  996.    or ((Status = HiStatus) and vForceCase) then
  997.       vInputStr := AdjCase(vCase,vInputStr);
  998.    case Status of
  999.      HiStatus:    A:= IOTOT^.FieldCol(2);
  1000.      Norm:  A:= IOTOT^.FieldCol(1);
  1001.      Off:   A:= IOTOT^.FieldCol(4);
  1002.    end; {case}
  1003.    if (vDispChar = ' ') then
  1004.       AdjStr := vInputStr
  1005.    else
  1006.       AdjStr := Replicate(length(vInputStr),vDispChar);
  1007.    if Status <> HiStatus then
  1008.       vInputStr := AdjCase(vCase,vInputStr);
  1009.    TempStr := TruncFormat(AdjStr,vStartChar,vFieldLen,vPad);
  1010.    Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,TempStr);
  1011. end; {LateralIOOBJ.ReDisplay}
  1012.  
  1013. function LateralIOOBJ.CursorOffset(InputPos:byte):byte;
  1014. {}
  1015. begin
  1016.    CursorOffset := succ(InputPos - vStartChar)
  1017. end; {LateralIOOBJ.CursorOffset}
  1018.  
  1019. procedure LateralIOOBJ.PosCursor;
  1020. {}
  1021. begin
  1022.    case vCursor of
  1023.       CursLeft:  begin
  1024.                     vCursorStr := 1;
  1025.                     vStartChar := 1;
  1026.                  end;
  1027.       CursRight: begin
  1028.                     vCursorStr := succ(length(vInputStr));
  1029.                     if vCursorStr - vStartChar > vFieldLen then
  1030.                        vStartChar := vCursorStr - vFieldLen;
  1031.                  end;
  1032.       CursPrev:  {do nothing};
  1033.    end; {case}
  1034. end; {LateralIOOBJ.PosCursor}
  1035.  
  1036. procedure LateralIOOBJ.CursorHome;
  1037. {}
  1038. begin
  1039.    vCursorStr := 1;
  1040.    if vStartChar <> 1 then
  1041.    begin
  1042.       vStartChar := 1;
  1043.       ReDisplay(HiStatus);
  1044.    end;
  1045. end; {LateralIOOBJ.CursorHome}
  1046.  
  1047. procedure LateralIOOBJ.CursorEnd;
  1048. {}
  1049. begin
  1050.    if (vCursorStr <= length(vInputStr)) then
  1051.    begin
  1052.       vCursorStr := succ(length(vInputStr));
  1053.       if (vCursorStr - vStartChar) > vFieldLen then
  1054.       begin
  1055.          vStartChar := vCursorStr - vFieldLen;
  1056.          ReDisplay(HiStatus);
  1057.       end;
  1058.    end;
  1059. end; {LateralIOOBJ.CursorEnd}
  1060.  
  1061. procedure LateralIOOBJ.CursorLeft;
  1062. {}
  1063. begin
  1064.    if vCursorStr > 1 then
  1065.    begin
  1066.       if vCursorStr = vStartChar then
  1067.       begin
  1068.          dec(vStartChar);
  1069.          dec(vCursorStr);
  1070.          ReDisplay(HiStatus)
  1071.       end
  1072.       else
  1073.          dec(vCursorStr);
  1074.    end;
  1075. end; {LateralIOOBJ.CursorLeft}
  1076.  
  1077. procedure LateralIOOBJ.CursorRight;
  1078. {}
  1079. begin
  1080.    if (vCursorStr <= length(vInputStr)) then
  1081.    begin
  1082.       if vCursorStr - vStartChar = vFieldLen then
  1083.       begin
  1084.          inc(vStartChar);
  1085.          inc(vCursorStr);
  1086.          ReDisplay(HiStatus);
  1087.       end
  1088.       else
  1089.          inc(vCursorStr);
  1090.    end;
  1091. end; {LateralIOOBJ.CursorRight}
  1092.  
  1093. procedure LateralIOOBJ.Erase;
  1094. {}
  1095. begin
  1096.    vInputStr := '';
  1097.    vStartChar := 1;
  1098.    vCursorStr := 1;
  1099.    PosCursor;
  1100.    Display(HiStatus);
  1101. end; {LateralIOOBJ.Erase}
  1102.  
  1103. procedure LateralIOOBJ.DeleteChar;
  1104. {}
  1105. begin
  1106.   delete(vInputStr,vCursorStr,1);
  1107.   ReDisplay(HiStatus);
  1108. end; {LateralIOOBJ.DeleteChar}
  1109.  
  1110. procedure LateralIOOBJ.BackSpace;
  1111. {}
  1112. begin
  1113.    if vCursorStr > 1 then
  1114.    begin
  1115.       CursorLeft;
  1116.       DeleteChar;
  1117.       ReDisplay(HiStatus)
  1118.    end;
  1119. end; {LateralIOOBJ.BackSpace}
  1120.  
  1121. procedure LateralIOOBJ.MoveCursor;
  1122. {}
  1123. begin
  1124.    Screen.GotoXY(pred(vBoundary.X1)+vCursorStr - pred(vStartChar),vBoundary.Y1);
  1125. end; {LateralIOOBJ.MoveCursor}
  1126.  
  1127. function LateralIOOBJ.GetValue:string;
  1128. {}
  1129. begin
  1130.    GetValue := vInputStr;
  1131. end; {LateralIOOBJ.GetValue}
  1132.  
  1133. destructor LateralIOOBJ.Done;
  1134. {}
  1135. begin
  1136.    CharIOOBJ.Done;
  1137. end; {StringFieldOBJ.Done}
  1138. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1139. {                                                }
  1140. {     L i s t F i e l d O B J   M E T H O D S    }
  1141. {                                                }
  1142. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1143. {$I totIO2.INC}
  1144. {||||||||||||||||||||||||||||||||||||||||||||||||||}
  1145. {                                                  }
  1146. {     A r r a y F i e l d O B J   M E T H O D S    }
  1147. {                                                  }
  1148. {||||||||||||||||||||||||||||||||||||||||||||||||||}
  1149.  
  1150. constructor ArrayIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1151. {}
  1152. begin
  1153.    ListIOOBJ.Init(X1,Y1,width,depth,Title);
  1154. end; {ArrayIOOBJ.Init}
  1155.  
  1156. procedure ArrayIOOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
  1157. {}
  1158. begin
  1159.    vArrayPtr := @StrArray;
  1160.    vStrLength := StrLength;
  1161.    vTotPicks := Total;
  1162.    vListAssigned := true;
  1163. end; {ArrayIOOBJ.AssignList}
  1164.  
  1165. function ArrayIOOBJ.GetString(Pick:integer): string;
  1166. {}
  1167. var
  1168.   W : word;
  1169.   TempStr : String;
  1170.   ArrayOffset: word;
  1171. begin
  1172.    if (Pick > 0) and (Pick <= vTotPicks) then
  1173.    begin
  1174.       W := pred(Pick) * succ(vStrLength);
  1175.       ArrayOffset := Ofs(vArrayPtr^) + W;
  1176.       Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
  1177.       Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  1178.    end
  1179.    else
  1180.       TempStr := '';
  1181.    W := vBorder.X2 - succ(vBorder.X1);
  1182.    GetString := Padleft(TempStr,W,' ');
  1183. end; {ArrayIOOBJ.GetString}
  1184.  
  1185. destructor ArrayIOOBJ.Done;
  1186. {}
  1187. begin
  1188.    ListIOOBJ.Done;
  1189. end; {ArrayIOOBJ.Done}
  1190. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1191. {                                                }
  1192. {     L i s t F i e l d O B J   M E T H O D S    }
  1193. {                                                }
  1194. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1195. constructor LinkIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1196. {}
  1197. begin
  1198.    ListIOOBJ.Init(X1,Y1,width,depth,Title);
  1199. end; {LinkIOOBJ.Init}
  1200.  
  1201. procedure LinkIOOBJ.AssignList(var LinkList: DLLOBJ);
  1202. {}
  1203. begin
  1204.    vLinkList := @LinkList;
  1205.    vTotPicks := LinkList.TotalNodes;
  1206.    vListAssigned := true;
  1207. end;  {LinkIOOBJ.AssignList}
  1208.  
  1209. function LinkIOOBJ.GetString(Pick:integer): string;
  1210. {}
  1211. var
  1212.   TempPtr : DLLNodePtr;
  1213. begin
  1214.    TempPtr := vLinkList^.NodePtr(Pick);
  1215.    if TempPtr <> Nil then
  1216.       vLinkList^.ShiftActiveNode(TempPtr,Pick);
  1217.    GetString := vLinkList^.GetStr(TempPtr,1,vBorder.X2 - vBorder.X1);
  1218. end; {LinkIOOBJ.GetString}
  1219.  
  1220. destructor LinkIOOBJ.Done;
  1221. {}
  1222. begin
  1223.    ListIOOBJ.Done;
  1224. end; {LinkIOOBJ.Done}
  1225. {||||||||||||||||||||||||||||||||||||||||}
  1226. {                                        }
  1227. {     I n t I O O B J   M E T H O D S    }
  1228. {                                        }
  1229. {||||||||||||||||||||||||||||||||||||||||}
  1230. constructor IntIOOBJ.Init(X,Y,Len:byte);
  1231. {}
  1232. begin
  1233.    CharIOOBJ.Init(X,Y,Len);
  1234.    vMin := 0;
  1235.    vMax := 0;
  1236.    vFmtPtr := Nil;
  1237. end; {IntIOOBJ.Init}
  1238.  
  1239. function IntIOOBJ.FormatPtr: pFmtNumberOBJ;
  1240. {}
  1241. begin
  1242.    FormatPtr := vFmtPtr;
  1243. end; {IntIOOBJ.FormatPtr}
  1244.  
  1245. procedure IntIOOBJ.InitFormat;
  1246. {}
  1247. begin
  1248.    if vFmtPtr <> nil then
  1249.       Dispose(vFmtPtr,Done);
  1250.    new(vFmtPtr,Init);
  1251.    vFmtPtr^ := FmtNumberTOT;
  1252. end; {IntIOOBJ.InitFormat}
  1253.  
  1254. procedure IntIOOBJ.SetMinMax(Min,Max:longint);
  1255. {}
  1256. begin
  1257. {$IFDEF CHECK}
  1258.    if Min > Max then
  1259.    begin
  1260.      vMax := Min;
  1261.      vMin := Max;
  1262.    end
  1263.    else
  1264.    begin
  1265.      vMax := Max;
  1266.      vMin := Min;
  1267.    end;
  1268. {$ELSE}
  1269.    vMax := Max;
  1270.    vMin := Min;
  1271. {$ENDIF}
  1272. end; {IntIOOBJ.SetMinMax}
  1273.  
  1274. procedure IntIOOBJ.SetValue(Val:longint);
  1275. {}
  1276. begin
  1277.    if  ((vRules and SuppressZero) = SuppressZero)
  1278.    and (Val = 0) then
  1279.       vInputStr := ''
  1280.    else
  1281.       vInputStr := IntToStr(Val);
  1282. {$IFDEF CHECK}
  1283.    if VMax <> vMin then
  1284.    begin
  1285.       if Val < vMin then
  1286.          vMin := Val
  1287.       else if Val > vMax then
  1288.       begin
  1289.          vMax := Val;
  1290.          vMaxLen := length(IntToStr(vMax));
  1291.       end;
  1292.    end;
  1293. {$ENDIF}
  1294. end;  {IntIOOBJ.SetValue}
  1295.  
  1296. function IntIOOBJ.GetValue:longint;
  1297. {}
  1298. begin
  1299.    if ValidInt(vInputStr) then
  1300.       GetValue := StrToLong(vInputStr)
  1301.    else
  1302.       GetValue := 0;
  1303. end;  {IntIOOBJ.GetValue}
  1304.  
  1305. function IntIOOBJ.CharOK(var Ch:char):boolean;
  1306. {}
  1307. begin
  1308.    if (Ch = '+') and ((pos('+',vInputStr)>0) or (vCursorStr > 1))
  1309.    or (Ch = '-') and ((pos('-',vInputStr)>0) or (vCursorStr > 1)) then
  1310.       CharOK := false
  1311.    else
  1312.       CharOK :=    (Ch in  ['0'..'9'])
  1313.              or (  (Ch='-') and ((vMin=vMax) or (vMin < 0)))
  1314.              or (  (Ch='+') and ((vMin=vMax) or (vMax > 0)))
  1315. end; {IntIOOBJ.CharOK}
  1316.  
  1317. procedure IntIOOBJ.ReDisplay(Status:tStatus);
  1318. {}
  1319. var
  1320.   A: byte;
  1321.   AdjStr: String;
  1322.   L: longint;
  1323. begin
  1324.    if (Status = Norm) and (vFmtPtr <> Nil) then
  1325.    begin
  1326.       L := GetValue;
  1327.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1328.                      IOTOT^.FieldCol(1),
  1329.                      vFmtPtr^.FormattedLong(L,vMaxLen))
  1330.    end
  1331.    else
  1332.    begin
  1333.       AdjStr := vInputStr;
  1334.       SetFieldAttr(Status,A,AdjStr);
  1335.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(vInputStr,vMaxlen,vPad));
  1336.    end;
  1337. end; {IntIOOBJ.ReDisplay}
  1338.  
  1339. function IntIOOBJ.Suspend:boolean;
  1340. {}
  1341. var
  1342.   L : longint;
  1343. begin
  1344.    L := GetValue;
  1345.    if  (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  1346.    and (vMax <> vMin)
  1347.    and ((ValidInt(vInputStr) = false) or (L > vMax) or (L < vMin))
  1348.    then   {Invalid}
  1349.    begin
  1350.       ValidationMessage(NumberError[1],
  1351.                         NumberError[2],
  1352.                         '',
  1353.                         IntToStr(vMin)+' - '+IntToStr(vMax));
  1354.       Suspend := false;
  1355.    end
  1356.    else
  1357.    begin
  1358.       ReDisplay(Norm);
  1359.       WriteLabel(Norm);
  1360.       ClearMessage;
  1361.       Suspend := true;
  1362.    end;
  1363. end; {IntIOOBJ.Suspend}
  1364.  
  1365. destructor IntIOOBJ.Done;
  1366. {}
  1367. begin
  1368.    CharIOOBJ.Done;
  1369.    if vFmtPtr <> nil then
  1370.       Dispose(vFmtPtr,Done);
  1371. end; {IntIOOBJ.Done}
  1372. {||||||||||||||||||||||||||||||||||||||||||}
  1373. {                                          }
  1374. {     R e a l I O O B J   M E T H O D S    }
  1375. {                                          }
  1376. {||||||||||||||||||||||||||||||||||||||||||}
  1377. constructor RealIOOBJ.Init(X,Y,Len:byte);
  1378. {}
  1379. begin
  1380.    CharIOOBJ.Init(X,Y,Len);
  1381.    vENotation := false;
  1382.    vMax := 0;
  1383.    vMin := 0;
  1384.    vFmtPtr := Nil;
  1385. end; {RealIOOBJ.Init}
  1386.  
  1387. function RealIOOBJ.FormatPtr: pFmtNumberOBJ;
  1388. {}
  1389. begin
  1390.    FormatPtr := vFmtPtr;
  1391. end; {RealIOOBJ.FormatPtr}
  1392.  
  1393. procedure RealIOOBJ.InitFormat;
  1394. {}
  1395. begin
  1396.    if vFmtPtr <> nil then
  1397.       Dispose(vFmtPtr,Done);
  1398.    new(vFmtPtr,Init);
  1399.    vFmtPtr^ := FmtNumberTOT;
  1400. end; {RealIOOBJ.InitFormat}
  1401.  
  1402. procedure RealIOOBJ.SetMinMax(Min,Max:extended);
  1403. {}
  1404. begin
  1405. {$IFDEF CHECK}
  1406.    if Min > Max then
  1407.    begin
  1408.      vMax := Min;
  1409.      vMin := Max;
  1410.    end
  1411.    else
  1412.    begin
  1413.      vMax := Max;
  1414.      vMin := Min;
  1415.    end;
  1416. {$ELSE}
  1417.    vMax := Max;
  1418.    vMin := Min;
  1419. {$ENDIF}
  1420. end; {RealIOOBJ.SetMinMax}
  1421.  
  1422. procedure RealIOOBJ.SetValue(Val:extended);
  1423. {}
  1424. begin
  1425.    if  ((vRules and SuppressZero) = SuppressZero)
  1426.    and (Val = 0.0) then
  1427.       vInputStr := ''
  1428.    else
  1429.    begin
  1430.       if vENotation then
  1431.          vInputStr := RealtoSciStr(Val,Floating)
  1432.       else
  1433.          vInputStr := RealToStr(Val,Floating);
  1434.    end;
  1435. {$IFDEF CHECK}
  1436.    if vMax <> vMin then
  1437.    begin
  1438.       if Val < vMin then
  1439.          vMin := Val
  1440.       else if Val > vMax then
  1441.          vMax := Val;
  1442.    end;
  1443. {$ENDIF}
  1444. end;  {RealIOOBJ.SetValue}
  1445.  
  1446. function RealIOOBJ.GetValue:extended;
  1447. {}
  1448. begin
  1449.    if ValidReal(vInputStr) then
  1450.       GetValue := StrToReal(vInputStr)
  1451.    else
  1452.       GetValue := 0;
  1453. end;  {RealIOOBJ.GetValue}
  1454.  
  1455. procedure RealIOOBJ.SetENotation(On:Boolean);
  1456. {}
  1457. begin
  1458.    vEnotation := On;
  1459. end; {RealIOOBJ.SetENotation}
  1460.  
  1461. function RealIOOBJ.CharOK(var Ch:char):boolean;
  1462. {}
  1463. var DC : char;
  1464. begin
  1465.    DC := FmtNumberTOT.GetDecimal;
  1466.    if ((Ch = DC) and (pos(DC,vInputStr)>0)) 
  1467.    or ((Ch = '-') and (pos('-',vInputStr)>0))
  1468.    or ((Ch = '+') and (pos('+',vInputStr)>0))
  1469.    then
  1470.       CharOK := false
  1471.    else
  1472.       CharOK :=    (Ch in  ['0'..'9','+',DC])
  1473.                 or (  (Ch in ['E','e']) and vENotation)
  1474.                 or (  (Ch='-') and (vMin < 0));
  1475. end; {RealIOOBJ.CharOK}
  1476.  
  1477. procedure RealIOOBJ.ReDisplay(Status:tStatus);
  1478. {}
  1479. var
  1480.   A: byte;
  1481.   AdjStr: String;
  1482.   E: extended;
  1483. begin
  1484.    if (Status = Norm) and (vFmtPtr <> Nil) then
  1485.    begin
  1486.       E := GetValue;
  1487.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1488.                      IOTOT^.FieldCol(1),
  1489.                      vFmtPtr^.FormattedReal(E,Floating,vMaxLen))
  1490.    end
  1491.    else
  1492.    begin
  1493.       AdjStr := vInputStr;
  1494.       SetFieldAttr(Status,A,AdjStr);
  1495.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(vInputStr,vMaxlen,vPad));
  1496.    end;
  1497. end; {RealIOOBJ.ReDisplay}
  1498.  
  1499. function RealIOOBJ.Suspend:boolean;
  1500. {}
  1501. var
  1502.   E : extended;
  1503.   MsgStr: string;
  1504. begin
  1505.    E := GetValue;
  1506.    if  (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  1507.    and (vMax <> vMin)
  1508.    and ((ValidReal(vInputStr) = false) or (E > vMax) or (E < vMin))
  1509.    then   {Invalid}
  1510.    begin
  1511.       if vENotation then
  1512.          MsgStr := RealtoSciStr(vMin,Floating)+' - '+RealtoSciStr(vMax,Floating)
  1513.       else
  1514.          MsgStr := RealToStr(vMin,Floating)+' - '+RealToStr(vMax,Floating);
  1515.       ValidationMessage(NumberError[1],
  1516.                         NumberError[2],
  1517.                         '',
  1518.                         MsgStr);
  1519.       Suspend := false;
  1520.    end
  1521.    else
  1522.    begin
  1523.       ReDisplay(Norm);
  1524.       WriteLabel(Norm);
  1525.       ClearMessage;
  1526.       Suspend := true;
  1527.    end;
  1528. end; {RealIOOBJ.Suspend}
  1529.  
  1530. destructor RealIOOBJ.Done;
  1531. {}
  1532. begin
  1533.    CharIOOBJ.Done;
  1534.    if vFmtPtr <> nil then
  1535.       Dispose(vFmtPtr,Done);
  1536. end; {RealIOOBJ.Done}
  1537.  
  1538. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1539. {                                                    }
  1540. {     F i x e d R e a l I O O B J   M E T H O D S    }
  1541. {                                                    }
  1542. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1543. constructor FixedRealIOOBJ.Init(X,Y,Whole,DP:byte);
  1544. {}
  1545. begin
  1546.    SingleLineIOOBJ.Init;
  1547.    vMax := 0;
  1548.    vMin := 0;
  1549.    vDP := DP;
  1550.    vWholeP := Whole;
  1551.    if vDP > 0 then
  1552.       vMaxlen := succ(vWholeP) + vDP
  1553.    else
  1554.       vMaxlen := vWholeP;
  1555.    vBoundary.X1 := X;
  1556.    vBoundary.X2 := pred(vBoundary.X1 + vMaxlen);
  1557.    vBoundary.Y1 := Y;
  1558.    vBoundary.Y2 := vBoundary.Y1;
  1559.    vCursorPos := 1;
  1560.    vPad := ' ';
  1561.    vWholeStr:= replicate(vWholeP,vPad);
  1562.    vDPStr :=  replicate(vDP,vPad);
  1563.    vFmtPtr := Nil;
  1564. end; {FixedRealIOOBJ.Init}
  1565.  
  1566. function FixedRealIOOBJ.FormatPtr: pFmtNumberOBJ;
  1567. {}
  1568. begin
  1569.    FormatPtr := vFmtPtr;
  1570. end; {FixedRealIOOBJ.FormatPtr}
  1571.  
  1572. procedure FixedRealIOOBJ.InitFormat;
  1573. {}
  1574. begin
  1575.    if vFmtPtr <> nil then
  1576.       Dispose(vFmtPtr,Done);
  1577.    New(vFmtPtr,Init);
  1578.    vFmtPtr^ := FmtNumberTOT;
  1579. end; {FixedRealIOOBJ.InitFormat}
  1580.  
  1581. procedure FixedRealIOOBJ.SetMinMax(Min,Max:extended);
  1582. {}
  1583. begin
  1584. {$IFDEF CHECK}
  1585.    if Min > Max then
  1586.    begin
  1587.      vMax := Min;
  1588.      vMin := Max;
  1589.    end
  1590.    else
  1591.    begin
  1592.      vMax := Max;
  1593.      vMin := Min;
  1594.    end;
  1595. {$ELSE}
  1596.    vMax := Max;
  1597.    vMin := Min;
  1598. {$ENDIF}
  1599. end; {FixedRealIOOBJ.SetMinMax}
  1600.  
  1601. procedure FixedRealIOOBJ.SetValue(Val:extended);
  1602. {}
  1603. var
  1604.   TempStr : string;
  1605.   P : Byte;
  1606. begin
  1607.    vDPStr := replicate(vDP,vPad);
  1608.    if ((vRules and SuppressZero) = SuppressZero)
  1609.    and (Val = 0.0) then
  1610.       vWholeStr := replicate(vWholeP,vPad)
  1611.    else
  1612.    begin
  1613.      TempStr := RealToStr(Val,vDP);
  1614.      P := Pos('.',TempStr);
  1615.      if (P = 0) or (vDP = 0) then
  1616.         vWholeStr := padright(TempStr,vWholeP,vPad)
  1617.      else
  1618.      begin
  1619.         vWholeStr := padright(copy(TempStr,1,pred(P)),vWholeP,vPad);
  1620.         vDPStr := padleft(copy(TempStr,succ(P),vDP),vDP,vPad);
  1621.      end;
  1622.    end;
  1623. {$IFDEF CHECK}
  1624.    if vMin <> vMax then
  1625.    begin
  1626.       if Val < vMin then
  1627.          vMin := Val
  1628.       else if Val > vMax then
  1629.          vMax := Val;
  1630.    end;
  1631. {$ENDIF}
  1632. end;  {FixedRealIOOBJ.SetValue}
  1633.  
  1634. procedure FixedRealIOOBJ.Condense;
  1635. {}
  1636. begin
  1637.    if vWholeStr [1] = '-' then
  1638.    begin
  1639.       delete(vWholeStr,1,1);
  1640.       vWholeStr := '-'+padright(Strip('A',vPad,vWholeStr),pred(vWholeP),vPad);
  1641.    end
  1642.    else
  1643.       vWholeStr := padright(Strip('A',vPad,vWholeStr),vWholeP,vPad);
  1644.    vDPStr := padleft(Strip('A',vPad,vDPStr),vDP,'0');
  1645. end; {FixedRealIOOBJ.Condense}
  1646.  
  1647. function FixedRealIOOBJ.GetValue:extended;
  1648. {}
  1649. var ValStr: string;
  1650. begin
  1651.    Condense;
  1652.    ValStr := vWholeStr+'.'+vDPStr;
  1653.    ValStr := strip('A',vPad,ValStr);
  1654.    if ValidReal(ValStr) then
  1655.       GetValue := StrToReal(ValStr)
  1656.    else
  1657.       GetValue := 0;
  1658. end;  {FixedRealIOOBJ.GetValue}
  1659.  
  1660. procedure FixedRealIOOBJ.PeriodHit;
  1661. {}
  1662. begin
  1663.    Condense;
  1664.    if vDP > 0 then
  1665.       vCursorPos := vWholeP + 2
  1666.    else
  1667.       vCursorPos := vWholeP;
  1668.    Display(HiStatus);
  1669. end; {FixedRealIOOBJ.PeriodHit}
  1670.  
  1671. procedure FixedRealIOOBJ.PlusHit;
  1672. {}
  1673. var P: byte;
  1674. begin
  1675.    P := pos('-',vWholeStr);
  1676.    if P > 0 then
  1677.    begin
  1678.       delete(vWholeStr,P,1);
  1679.       insert(vPad,vWholeStr,P);
  1680.       Display(HiStatus);
  1681.    end;
  1682. end; {FixedRealIOOBJ.PlusHit}
  1683.  
  1684. procedure FixedRealIOOBJ.MinusHit;
  1685. {}
  1686. var P: byte;
  1687. begin
  1688.    if vMin >= 0.0 then
  1689.       ding
  1690.    else
  1691.    begin
  1692.       P := pos('-',vWholeStr);
  1693.       if P = 0 then
  1694.       begin
  1695.          P := pos(vPad,vWholeStr);
  1696.          if P = 0 then
  1697.             ding
  1698.          else
  1699.          begin
  1700.             delete(vWholeStr,P,1);
  1701.             vWholeStr := '-'+vWholeStr;
  1702.          end;
  1703.          Display(HiStatus);
  1704.          if vCursorPos = 1 then
  1705.             CursorRight;
  1706.       end;
  1707.    end;
  1708. end; {FixedRealIOOBJ.MinusHit}
  1709.  
  1710. procedure FixedRealIOOBJ.CursorHome;
  1711. {}
  1712. begin
  1713.    vCursorPos := 1;
  1714.    Display(HiStatus);
  1715. end; {FixedRealIOOBJ.CursorHome}
  1716.  
  1717. procedure FixedRealIOOBJ.CursorEnd;
  1718. {}
  1719. begin
  1720.    vCursorPos := vMaxlen;
  1721. end; {FixedRealIOOBJ.CursorEnd}
  1722.  
  1723. procedure FixedRealIOOBJ.CursorLeft;
  1724. {}
  1725. begin
  1726.    if vCursorPos > 1 then
  1727.       dec(vCursorPos);
  1728.    if (vCursorPos = succ(vWholeP)) then
  1729.       dec(vCursorPos);
  1730. end; {FixedRealIOOBJ.CursorLeft}
  1731.  
  1732. procedure FixedRealIOOBJ.CursorRight;
  1733. {}
  1734. begin
  1735.    if vCursorPos < vMaxlen then
  1736.       inc(vCursorPos);
  1737.    if (vCursorPos = succ(vWholeP)) then
  1738.       inc(vCursorPos);
  1739. end; {FixedRealIOOBJ.CursorRight}
  1740.  
  1741. procedure FixedRealIOOBJ.Erase;
  1742. {}
  1743. begin
  1744.    vWholeStr := replicate(vWholeP,vPad);
  1745.    vDPStr := replicate(vDP,vPad);
  1746.    vCursorPos := 1;
  1747.    Display(HiStatus);
  1748. end; {FixedRealIOOBJ.Erase}
  1749.  
  1750. procedure FixedRealIOOBJ.DeleteChar;
  1751. {}
  1752. var P : byte;
  1753. begin
  1754.   if vCursorPos  <= vWholeP then
  1755.   begin
  1756.      P := vCursorPos-(vWholeP-length(vWholeStr));
  1757.      delete(vWholeStr,P,1);
  1758.      insert(vPad,vWholeStr,P);
  1759.   end
  1760.   else
  1761.   begin
  1762.      P := vCursorPos - succ(vWholeP);
  1763.      delete(vDPStr,P,1);
  1764.      insert(vPad,vDPStr,P);
  1765.   end;
  1766.   Display(HiStatus);
  1767. end; {FixedRealIOOBJ.DeleteChar}
  1768.  
  1769. procedure FixedRealIOOBJ.BackSpace;
  1770. {}
  1771. begin
  1772.    if vCursorPos > 1 then
  1773.    begin
  1774.       CursorLeft;
  1775.       DeleteChar;
  1776.       Display(HiStatus)
  1777.    end;
  1778. end; {FixedRealIOOBJ.BackSpace}
  1779.  
  1780. function FixedRealIOOBJ.ProcessEnter:tAction;
  1781. {}
  1782. begin
  1783.  
  1784.    ProcessEnter := Enter;
  1785. end; {FixedRealIOOBJ.ProcessEnter}
  1786.  
  1787. procedure FixedRealIOOBJ.MoveCursor;
  1788. {}
  1789. begin
  1790.    Screen.GotoXY(pred(vBoundary.X1)+vCursorPos,vBoundary.Y1);
  1791. end; {FixedRealIOOBJ.MoveCursor}
  1792.  
  1793. procedure FixedRealIOOBJ.Display(Status:tStatus);
  1794. {}
  1795. var
  1796.   A: byte;
  1797.   AdjStr: String;
  1798.   E: Extended;
  1799. begin
  1800.    if (Status <> HiStatus) and (vFmtPtr <> nil) then
  1801.    begin
  1802.       E := GetValue;
  1803.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1804.                      IOTOT^.FieldCol(1),
  1805.                      vFmtPtr^.FormattedReal(E,vDP,vMaxLen))
  1806.    end
  1807.    else
  1808.    begin
  1809.       AdjStr := vWholeStr;
  1810.       if vDP > 0 then
  1811.          AdjStr := AdjStr + FmtNumberTOT.GetDecimal+vDPStr;
  1812.       SetFieldAttr(Status,A,AdjStr);
  1813.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,AdjStr);
  1814.    end;
  1815. end; {FixedRealIOOBJ.Display}
  1816.  
  1817. procedure FixedRealIOOBJ.ProcessChar(Ch:char);
  1818. {}
  1819. var
  1820.   P,WholePos,DPPos: byte;
  1821.  
  1822.    procedure EraseOld;
  1823.    {}
  1824.    begin
  1825.       if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then
  1826.          Erase;
  1827.    end; {EraseOld}
  1828.  
  1829. begin
  1830.    if Ch in ['0'..'9'] then
  1831.       EraseOld
  1832.    else
  1833.    begin
  1834.       Ding;
  1835.       exit
  1836.    end;
  1837.    WholePos := vCursorPos-(vWholeP-length(vWholeStr));
  1838.    if vCursorPos > vWholeP then  {entering decimals}
  1839.       DPPos := vCursorPos - succ(vWholeP)
  1840.    else
  1841.       DPPos := 0;
  1842.    if not vInsert then
  1843.    begin
  1844.       if DPPOS > 0 then  {entering decimals}
  1845.       begin
  1846.          delete(vDPStr,DPPos,1);
  1847.          insert(Ch,vDPStr,DPPos);
  1848.       end
  1849.       else  {entering whole numbers}
  1850.       begin
  1851.          delete(vWholeStr,WholePos,1);
  1852.          insert(Ch,vWholeStr,WholePos);
  1853.       end;
  1854.    end
  1855.    else
  1856.    begin
  1857.       if DPPos > 0 then  {entering decimals}
  1858.       begin
  1859.          if vDPStr[DPPos] = vPad then
  1860.          begin
  1861.             delete(vDPStr,DPPos,1);
  1862.             insert(Ch,vDPStr,DPPos);
  1863.          end
  1864.          else
  1865.          begin
  1866.             P := PosAfter(vPad,vDPStr,DPPos);
  1867.             if P = 0 then   {push a character off the end}
  1868.                delete(vDPStr,length(vDPStr),1)
  1869.             else
  1870.                delete(vDPStr,P,1);
  1871.             insert(Ch,vDPStr,DPPos);
  1872.          end;
  1873.       end
  1874.       else  {entering whole numbers}
  1875.       begin
  1876.          if vWholeStr[WholePos] in [vPad,'-'] then
  1877.          begin
  1878.             delete(vWholeStr,WholePos,1);
  1879.             insert(Ch,vWholeStr,WholePos);
  1880.          end
  1881.          else
  1882.          begin
  1883.             P := LastPosBefore(vPad,vWholeStr,WholePos);
  1884.             if P = 0 then
  1885.                P := pos(vPad,vWholeStr);
  1886.             if P = 0 then   {no room for another character}
  1887.             begin
  1888.                Ding;
  1889.                exit;
  1890.             end
  1891.             else
  1892.             begin
  1893.                delete(vWholeStr,P,1);
  1894.                insert(Ch,vWholeStr,WholePos);
  1895.                if WholePos = vWholeP then
  1896.                begin
  1897.                   Display(HiStatus);  {don't cursor right}
  1898.                   exit;
  1899.                end;
  1900.             end;
  1901.          end;
  1902.       end;
  1903.    end;
  1904.    CursorRight;
  1905.    Display(HiStatus);
  1906. end; {FixedRealIOOBJ.ProcessChar}
  1907.  
  1908. function FixedRealIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  1909. {}
  1910. begin
  1911.    if InKey = ord(FmtNumberTOT.GetDecimal) then
  1912.       PeriodHit
  1913.    else
  1914.    Case InKey of
  1915.       8: BackSpace;
  1916.       339: DeleteChar;
  1917.       327: CursorHome;
  1918.       335: CursorEnd;
  1919.       331: CursorLeft;
  1920.       333: CursorRight;
  1921.       338: begin
  1922.               vInsert := not vInsert;
  1923.               InsertAction(vInsert);
  1924.            end;
  1925.       ord('+'): PlusHit;
  1926.       ord('-'): MinusHit;
  1927.       32..255: ProcessChar(chr(InKey));    {characters}
  1928.    end; {case}
  1929.    case InKey of
  1930.       13: ProcessKey := ProcessEnter;
  1931.       27: ProcessKey := Escaped;
  1932.       else ProcessKey := None;
  1933.    end; {case}
  1934.    vFirstKey := false;
  1935.    MoveCursor;
  1936. end; {FixedRealIOOBJ.ProcessKey}
  1937.  
  1938. procedure FixedRealIOOBJ.Activate;
  1939. {}
  1940. var
  1941.    Action: tAction;
  1942. begin
  1943.    repeat
  1944.       Action := Select(0,0,0);
  1945.       Display(HiStatus);
  1946.       WriteLabel(HiStatus);
  1947.       with Key do
  1948.          repeat
  1949.             GetInput;
  1950.             Action := ProcessKey(LastKey,LastX,LastY);
  1951.          until Action in [Finished,Escaped,Enter];
  1952.    until Suspend;
  1953. end; {FixedRealIOOBJ.Activate}
  1954.  
  1955. function FixedRealIOOBJ.Select(K:word; X,Y:byte): tAction;
  1956. {}
  1957. begin
  1958.    Display(HiStatus);
  1959.    WriteLabel(HiStatus);
  1960.    InsertAction(vInsert);
  1961.    WriteMessage;
  1962.    vFirstKey := true;
  1963.    MoveCursor;
  1964.    Select := None;
  1965. end; {FixedRealIOOBJ.Select}
  1966.  
  1967. function FixedRealIOOBJ.Suspend:boolean;
  1968. {}
  1969. var Col,L: byte;
  1970.     ValStr: string;
  1971.     E : extended;
  1972. begin
  1973.    E := GetValue;
  1974.    Condense;
  1975.    ValStr := vWholeStr+'.'+vDPStr;
  1976.    ValStr := strip('A',vPad,ValStr);
  1977.    if  (((vRules and AllowNull) = AllowNull) and (getValue=0) = false)
  1978.    and (vMax <> vMin)
  1979.    and ((ValidReal(ValStr) = false) or (E > vMax) or (E < vMin))
  1980.    then   {Invalid}
  1981.    begin
  1982.       ValidationMessage(NumberError[1],
  1983.                         NumberError[2],
  1984.                         '',
  1985.                         RealToStr(vMin,vDP)+' - '+RealToStr(vMax,vDP));
  1986.       Suspend := false;
  1987.    end
  1988.    else
  1989.    begin
  1990.       Display(Norm);
  1991.       WriteLabel(Norm);
  1992.       if vMsgPtr <> Nil then   {clear the message}
  1993.       begin
  1994.          move(vMsgPtr^,L,1);
  1995.          if L > 0 then
  1996.          begin
  1997.             Col := IOTOT^.MessageCol;
  1998.             if Col = 0 then
  1999.                Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
  2000.             else
  2001.                Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
  2002.          end;
  2003.       end;
  2004.       Suspend := true;
  2005.    end;
  2006. end; {FixedRealIOOBJ.Suspend}
  2007.  
  2008. destructor FixedRealIOOBJ.Done;
  2009. {}
  2010. begin
  2011.    SingleLineIOOBJ.Done;
  2012.    if vFmtPtr <> nil then
  2013.       Dispose(vFmtPtr,Done);
  2014. end; {FixedRealIOOBJ.Done}
  2015. {||||||||||||||||||||||||||||||||||||||||||}
  2016. {                                          }
  2017. {     D a t e I O O B J   M E T H O D S    }
  2018. {                                          }
  2019. {||||||||||||||||||||||||||||||||||||||||||}
  2020. constructor DateIOOBJ.Init(X,Y:byte;DateFmt:tDate);
  2021. {}
  2022. var 
  2023.   Pic:string[10];
  2024.   Sep:char;
  2025. begin
  2026.    vDateFmt := DateFmt;
  2027.    Sep := DateTOT^.GetSeparator;
  2028.    Case vDateFmt of
  2029.       MMDDYY,
  2030.       DDMMYY,
  2031.       YYMMDD:   Pic := '##'+Sep+'##'+Sep+'##';
  2032.       MMDDYYYY,
  2033.       DDMMYYYY: Pic := '##'+Sep+'##'+Sep+'####';
  2034.       MMYY:     Pic := '##'+Sep+'##';
  2035.       MMYYYY:   Pic := '##'+Sep+'####';
  2036.       YYYYMMDD: Pic := '####'+Sep+'##'+Sep+'##';
  2037.    end; {case}
  2038.    PictureIOOBJ.Init(X,Y,Pic);
  2039.    vMin := 0;
  2040.    vMax := 0;
  2041. end; {DateIOOBJ.Init}
  2042.  
  2043. procedure DateIOOBJ.SetMinMax(Min,Max:longint);
  2044. {}
  2045. begin
  2046. {$IFDEF CHECK}
  2047.    if Min > Max then
  2048.    begin
  2049.      vMax := Min;
  2050.      vMin := Max;
  2051.    end
  2052.    else
  2053.    begin
  2054.      vMax := Max;
  2055.      vMin := Min;
  2056.    end;
  2057. {$ELSE}
  2058.    vMax := Max;
  2059.    vMin := Min;
  2060. {$ENDIF}
  2061. end; {DateIOOBJ.SetMinMax}
  2062.  
  2063. procedure DateIOOBJ.SetValue(Date:longint);
  2064. {}
  2065. begin
  2066.    PictureIOOBJ.Setvalue(StripDateStr(JultoStr(Date,vDateFmt),vDateFmt));
  2067. end; {DateIOOBJ.SetValue}
  2068.  
  2069. function DateIOOBJ.GetValue: longint;
  2070. {}
  2071. begin
  2072.    if vInputStr = '' then
  2073.       GetValue := StrToJul('01/01/1980',DDMMYYYY)
  2074.    else
  2075.       GetValue := StrtoJul(vInputStr,vDateFmt);
  2076. end; {DateIOOBJ.GetValue}
  2077.  
  2078. function DateIOOBJ.Suspend:boolean;
  2079. {}
  2080. var
  2081.   L : longint;
  2082.   OK : boolean;
  2083. begin
  2084.    L := GetValue;
  2085.    OK := ValidDateStr(vInputStr,vDateFmt);
  2086.    if (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  2087.    and ( (OK = false)
  2088.          or ((vMax <> vMin) and ((L > vMax) or (L < vMin)))
  2089.        )
  2090.    then   {Invalid}
  2091.    begin
  2092.       if (OK = false) then
  2093.          ValidationMessage(DateError[1],
  2094.                            DateError[2],
  2095.                             '',
  2096.                             '      '+DateFormat(vDateFmt))
  2097.       else if (L < vMin) then
  2098.          ValidationMessage(DateError[3],
  2099.                            DateError[4],
  2100.                             '',
  2101.                             '   '+JulToStr(vMin,vDateFmt))
  2102.       else
  2103.          ValidationMessage(DateError[5],
  2104.                            DateError[6],
  2105.                             '',
  2106.                             '   '+JulToStr(vMax,vDateFmt));
  2107.       Suspend := false;
  2108.    end
  2109.    else
  2110.    begin
  2111.       ReDisplay(Norm);
  2112.       WriteLabel(Norm);
  2113.       ClearMessage;
  2114.       Suspend := true;
  2115.    end;
  2116. end; {DateIOOBJ.Suspend}
  2117.  
  2118. destructor DateIOOBJ.Done;
  2119. {}
  2120. begin
  2121.    PictureIOOBJ.Done;
  2122. end; {DateIOOBJ.Done}
  2123. {||||||||||||||||||||||||||||||||||||||||}
  2124. {                                        }
  2125. {     H E X I O O B J   M E T H O D S    }
  2126. {                                        }
  2127. {||||||||||||||||||||||||||||||||||||||||}
  2128. constructor HEXIOOBJ.Init(X,Y,Len:byte);
  2129. {}
  2130. begin
  2131.    PictureIOOBJ.Init(X,Y,replicate(len,'*'));
  2132.    SetAllowChar('0123456789aAbBcCdDeEfF');
  2133.    vMin := 0;
  2134.    vMax := 0;
  2135. end; {HEXIOOBJ.Init}
  2136.  
  2137. procedure HEXIOOBJ.SetMinMax(Min,Max:longint);
  2138. {}
  2139. begin
  2140. {$IFDEF CHECK}
  2141.    if Min > Max then
  2142.    begin
  2143.      vMax := Min;
  2144.      vMin := Max;
  2145.    end
  2146.    else
  2147.    begin
  2148.      vMax := Max;
  2149.      vMin := Min;
  2150.    end;
  2151. {$ELSE}
  2152.    vMax := Max;
  2153.    vMin := Min;
  2154. {$ENDIF}
  2155. end; {HEXIOOBJ.SetMinMax}
  2156.  
  2157. procedure HEXIOOBJ.SetValue(Val:longint);
  2158. {}
  2159. begin
  2160.    PictureIOOBJ.SetValue(InttoHEXStr(Val));
  2161. end; {HEXIOOBJ.SetValue}
  2162.  
  2163. function HEXIOOBJ.GetValue: longint;
  2164. {}
  2165. begin
  2166.    GetValue := HEXStrtoLong(vInputStr);
  2167. end; {HEXIOOBJ.GetValue}
  2168.  
  2169. function HEXIOOBJ.Suspend:boolean;
  2170. {}
  2171. var
  2172.   L : longint;
  2173. begin
  2174.    L := GetValue;
  2175.    if (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  2176.    and (vMax <> vMin)
  2177.    and ((L > vMax) or (L < vMin))
  2178.    then   {Invalid}
  2179.    begin
  2180.       ValidationMessage(NumberError[1],
  2181.                         NumberError[2],
  2182.                         '',
  2183.                         IntToHEXStr(vMin)+' - '+IntToHEXStr(vMax));
  2184.       Suspend := false;
  2185.    end
  2186.    else
  2187.    begin
  2188.       ReDisplay(Norm);
  2189.       WriteLabel(Norm);
  2190.       ClearMessage;
  2191.       Suspend := true;
  2192.    end;
  2193. end; {HEXIOOBJ.Suspend}
  2194.  
  2195. destructor HEXIOOBJ.Done;
  2196. {}
  2197. begin
  2198.    PictureIOOBJ.Done;
  2199. end; {HEXIOOBJ.Done}
  2200. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2201. {                                               }
  2202. {     U N I T   I N I T I A L I Z A T I O N     }
  2203. {                                               }
  2204. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2205. procedure IO2Init;
  2206. {initilizes objects and global variables}
  2207. begin
  2208.    FmtNumberTOT.Init;
  2209. end; {IO2Init}
  2210.  
  2211. {end of unit - add initialization routines below}
  2212. {$IFNDEF OVERLAY}
  2213. begin
  2214.    IO2Init;
  2215. {$ENDIF}
  2216. end.
  2217.